United Public Domain Gold 2/United Public Domain Gold 2.iso/education/pe019.dms/pe019.adf/whip/whip.amosSourceCode

AMOS Source Code | 1991-03-25 | 23KB | 1,106 lines

'
'                     ************************************************
'                     **                                            **
'                     **      DTP = Dunks Typing Programme          **
'                     **        (C) 1992  Duncan Moran              **
'                     **                                            **
'                     ** This PD version may be freely distributed  **
'                     **                                            **
'                     **        Last amended 3/7/92                 **
'                     **                                            **
'                     ************************************************
'
Dim A$(80)
Dim T$(80)
Global A$(),T$(),EOT,CHCNT,GOOD,K$,K,S,LASPC,MK,SEF,STAR,TLN,PCNT,SCUP,LSEF,BC
Global PSEL,SCRPOS,BEL,BSEL,PTX,PTY,PBX,PBY,XS,YS,XP,YP,LCNT,PAGE$,FRD,CHANGED
Global CM,TZ,MUS,IC,STP,SA,TED,TP,TXP,Z$,LIX,LIY,SLIX,SLIY,TM$,TT,TLL,BEOH,T1,F$
'
'
OFFWEGO
PAGESELECT
SETPAGE
BUTTONSUP
End
'
'
Procedure PAGESELECT
   Unpack 11 To 5
   Curs Off
   For N=300 To 200 Step -1
      Screen Display 5,,N,,
      If N/2=Int(N/2) Then Wait Vbl
   Next N
   Screen 5
   Reserve Zone 4
   Limit Mouse
   Set Zone 1,145,222 To 190,280
   Set Zone 2,210,222 To 258,280
   Set Zone 3,286,212 To 332,279
   Set Zone 4,353,212 To 398,279
   Repeat
      SX=X Mouse
      SY=Y Mouse
      PSEL=Zone(5,SX,SY)
   Until Mouse Click and PSEL>0
   Screen 0 : Cls : Screen 1 : Cls
   For N=200 To 300
      Screen Display 5,,N,,
      Wait Vbl
      Mvolume(300-N)/1.75
   Next N
   LCNT=1
   Music Off
   Reserve Zone
  Screen Close 5
End Proc
Procedure BUTTONSUP
   Unpack 12 To 4
   N=300
   Screen Display 4,,N,,
   Curs Off
   For N=300 To 250 Step -1
      Screen Display 4,,N,,
      If N/2=Int(N/2) Then Wait Vbl
   Next N
   SCRPOS=250
   SCRPOS=250
   Reserve Zone 12
   Set Zone 1,120,13 To 156,26
   Set Zone 2,36,34 To 78,46
   Set Zone 3,96,34 To 138,46
   Set Zone 4,156,34 To 196,46
   Set Zone 5,214,34 To 256,46
   Set Zone 6,274,34 To 314,46
   Set Zone 7,332,34 To 372,46
   Set Zone 8,390,34 To 432,46
   Set Zone 9,450,34 To 490,46
   Set Zone 10,508,34 To 550,46
   Set Zone 11,570,34 To 610,46
   Set Zone 12,492,13 To 526,26
   Limit Mouse
   Do
      Screen 4
      Limit Mouse
      WHICHBUTTON
   Loop
End Proc
Procedure SETPAGE
   On Menu Off
   Menu Off
   Screen 1 : Clip
   Screen 0
   Limit Mouse
   Clip
   Curs Off
   Ink 0
   TLL=620
   If PSEL=1 Then Box 5,5 To 635,250 : Clip 1,1 To 2,2 : LIY=25 : TLN=10 : PTX=1 : PTY=1 : PBX=2 : PBY=2
   If PSEL=2 Then Box 5,5 To 305,250 : Box 315,5 To 635,250 : Clip 315,5 To 635,250 : PTX=315 : PTY=5 : PBX=635 : PBY=250 : LIY=25 : TLN=10 : TLL=275
   If PSEL=3 Then Box 5,5 To 635,135 : Box 5,150 To 635,250 : Clip 5,5 To 635,135 : PTX=5 : PTY=5 : PBX=635 : PBY=135 : LIY=168 : TLN=4
   If PSEL=4 Then Box 5,5 To 635,220 : Box 5,225 To 635,250 : Clip 5,5 To 635,220 : PTX=5 : PTY=5 : PBX=635 : PBY=230 : LIY=245 : TLN=1
   LIX=16
   SLIX=LIX : SLIY=LIY
   If LCNT>1
      For N=1 To LCNT-1
         LIY=LIY+24
      Next N
   End If
   Screen Copy 0 To 1
   Menu On
   On Menu On
End Proc
Procedure WHICHBUTTON
   On Menu On
   MESS["Please select a tool or menu item."]
   INITIN
   BSEL=TZ
   MESS[Space$(36)]
   If BSEL<>8
      Screen Copy 0 To 1
   End If
   On BSEL Proc MOVSC,SQ,CIRC,TRIANG,LINER,FHAND,DROP,UNDO,FIL,WIPER,DUN,MOVSC
End Proc
Procedure DROPBUT
End Proc
Procedure FIL
   MESS["Click in the area to be filled"]
   INITIN
   If TZ=7 Then Pop Proc
   MESS[Space$(36)]
   MESS["Hang on a mo......."]
   Screen 0
   Ink IC : Set Pattern STP
   Paint XS,YS,0
   MESS[Space$(36)]
   On Menu On
End Proc
Procedure SQ
   MESS["Click on a corner"]
   INITIN
   If TZ=7 Then Pop Proc
   MESS[Space$(36)]
   MESS["Click on the opposite corner"]
   Screen 0
   Gr Writing 2
   Do
      Ink 8
      XP=X Screen(X Mouse)
      YP=Y Screen(Y Mouse)
      Box XS,YS To XP,YP
      Ink 1
      Box XS,YS To XP,YP
      Exit If Mouse Click
   Loop
   Gr Writing 1
   Ink IC
   Box XS,YS To XP,YP
   MESS[Space$(36)]
End Proc
Procedure CIRC
   MESS["Click on the centre spot"]
   INITIN
   If TZ=7 Then Pop Proc
   MESS[Space$(36)]
   MESS["Click when you have the right size"]
   Screen 0
   Gr Writing 2
   Do
      Ink 8
      XP=X Screen(X Mouse)
      YP=Y Screen(Y Mouse)
      R1=XP-XS : R2=YP-YS
      R1=Abs(R1) : R2=Abs(R2)
      If R1=0 Then R1=1
      If R2=0 Then R2=1
      Ellipse XS,YS,R1,R2
      Exit If Mouse Click
      Ink 1
      Ellipse XS,YS,R1,R2
      Exit If Mouse Click
   Loop
   Gr Writing 1
   Ink IC
   Ellipse XS,YS,R1,R2
   MESS[Space$(36)]
End Proc
Procedure TRIANG
   MESS["Click on first corner"]
   INITIN
   If TZ=7 Then Pop Proc
   X1=XS : Y1=YS
   For N=1 To 2
      MESS[Space$(36)]
      MESS["Click on the next corner"]
      Screen 0
      Gr Writing 2
      Do
         Ink 8
         XP=X Screen(X Mouse) : X2=XP
         YP=Y Screen(Y Mouse) : Y2=YP
         Draw XS,YS To XP,YP
         Ink 1
         Draw XS,YS To XP,YP
         Exit If Mouse Click
      Loop
      Gr Writing 1
      Ink IC
      Draw XS,YS To XP,YP
      XS=XP : YS=YP
   Next N
   Draw XP,YP To X1,Y1
   MESS[Space$(36)]
End Proc
Procedure LINER
   MESS["Click on the start point"]
   INITIN
   If TZ=7 Then Pop Proc
   MESS[Space$(36)]
   MESS["Click on the end point"]
   Screen 0
   Gr Writing 2
   Do
      Ink 8
      XP=X Screen(X Mouse)
      YP=Y Screen(Y Mouse)
      Draw XS,YS To XP,YP
      Ink 1
      Draw XS,YS To XP,YP
      Exit If Mouse Click
   Loop
   Gr Writing 1
   Ink IC
   Draw XS,YS To XP,YP
   MESS[Space$(36)]
End Proc
Procedure FHAND
   MESS["Press mouse key to draw "]
   INITIN
   If TZ=7 Then Pop Proc
   MESS[Space$(36)]
   MESS["Release when you have finished"]
   Screen 0
   Ink IC
   While Mouse Key>0
      XP=X Screen(X Mouse)
      YP=Y Screen(Y Mouse)
      Draw XS,YS To XP,YP
      Wait Vbl
      XS=XP : YS=YP
   Wend
   MESS[Space$(36)]
End Proc
Procedure DROP
   MESS[Space$(36)]
End Proc
Procedure UNDO
   Screen Copy 1 To 0
End Proc
Procedure WIPER
   Screen 0
   Cls 1,PTX,PTY To PBX,PBY
   Ink 0
   Box PTX,PTY To PBX,PBY
End Proc
Procedure FOURD
   MESS[Space$(36)]
   MESS["See you later!"]
   For N=SCRPOS To 300
      Screen Display 4,,N,,
      If N/2=Int(N/2) Then Wait Vbl
   Next N
   Wait Vbl
End Proc
Procedure MOVSC
   Volume 15
   If BSEL=1
      If MUS=1
         MESS["   Going up ...."]
      Else
         MESS["   Going up.....quietly"]
      End If
   End If
   If BSEL=12
      If MUS=1
         MESS["  Going down ..."]
      Else
         MESS["  Going down ... quietly"]
      End If
   End If
   While Mouse Key
      If BSEL=1 and SCRPOS>36 Then Dec SCRPOS
      If BSEL=1 and SCRPOS=36 Then MESS["Roof garden and swimming pool"]
      If BSEL=12 and SCRPOS<250 Then Inc SCRPOS
      If BSEL=12 and SCRPOS=250 Then MESS["Rock bottom - send donations now!"]
      Screen Display 4,,SCRPOS,,
      If MUS=1 Then Bell 83-(SCRPOS/3.2)
      Wait Vbl
   Wend
   MESS[Space$(36)]
   Volume 20
End Proc
Procedure DUMMY
End Proc
Procedure MESS[M$]
   Screen 4
   Pen 3 : Paper 6
   Locate 24,2
   Print M$
End Proc
Procedure INITIN
   Screen 0
   Limit Mouse
   Repeat
      SCEN=Scin(X Mouse,Y Mouse)
      If SCEN=4 and CM=2 Then Change Mouse 1 : CM=1 : If MUS=1 Then Sam Play 1
      If SCEN=0 and CM=1 Then Change Mouse 2 : CM=2 : If MUS=1 Then Sam Play 2
      If Y Mouse<45 and CM=2 and SCEN=0 Then Change Mouse 1 : CM=1 : If MUS=1 Then Sam Play 3
      Screen SCEN
      XS=X Screen(X Mouse)
      YS=Y Screen(Y Mouse)
      TZ=Zone(SCEN,XS,YS)
      MK=Mouse Key
   Until Mouse Click
   If MUS=1 Then Sam Play 3
End Proc
Procedure EXT
   If Choice(2)=1
      Parent
      Edit
   End If
End Proc
Procedure DING
   If MUS=0 Then Goto HERE
   D=(Dreg(0)*20)+2000
   DD=(Dreg(1)*30)+2000
   SR=(D+DD*3) : If SA>1 Then SR=SR/2 : If SA=2 Then SR=SR*1.5
   Sam Play 15,SA,SR
   HERE:
End Proc
Procedure MUS
   Change Mouse 1
   If Choice(2)=1 Then MUS=0
   If Choice(2)=2
      MUS=1
      SA=Choice(3)
   End If
   On Menu On
End Proc
Procedure CUL
   Change Mouse 1
   IC=Choice(2)
   Dec IC
   Ink IC
   On Menu On
End Proc
Procedure FL
   Change Mouse 1
   If Choice(2)=1
      STP=0
   Else
      STP=(Choice(2)+3)
   End If
   On Menu On
End Proc
Procedure ED
   Change Mouse 1
   '  FOURD
   'Load Iff "texbr.iff",5
   'Spack 5 To 13
   'Stop
   Unpack 13 To 5
   Screen 5
   Get Palette 5
   Screen Display 5,,300,,
   For N=300 To 175 Step -1
      Screen Display 5,,N,,
      Wait Vbl
   Next N
   If SEF<>LSEF
      CLTEX
   End If
   UPLINE
   '   Do
   '      Screen 5
   '      X=X Screen(X Mouse)
   '      Y=Y Screen(Y Mouse)
   '      Repeat : Until Mouse Click
   '      Screen 0
   '      Print X;" ";Y
   '  Loop
   On Menu Off
   Menu Off
   TED=1
   BEOH=10
End Proc
Procedure PGE
   Change Mouse 1
   If Choice(2) Then PAGESELECT : SETPAGE
   On Menu On
End Proc
Procedure EX
   LSEF=SEF
   SEF=(Choice(2)+2)
   STAR=15
   If PSEL<>2
      If SEF=6 or SEF=9
         STAR=2
      End If
   End If
   On Menu On
End Proc
Procedure EDBUTDOWN
   Wait Vbl
   If Not SCUP
      Screen Display 5,,300,,
      For N=175 To 300
         Screen Display 5,,N,,
         If N/2=Int(N/2)
            Wait Vbl
         End If
      Next N
      Wait Vbl
   Else
      Wait Vbl
      MOVTXSCD
      Wait Vbl
      For N=175 To 300
         Screen Display 5,,N,,
         If N/2=Int(N/2)
            Wait Vbl
         End If
      Next N
      Wait Vbl
   End If
   Screen Close 5
   If FRD Then FOURUP
   Screen 4
   Limit Mouse
End Proc
Procedure TEX
   SETUP
   Do
      If CHCNT>EOT Then EOT=CHCNT
      '      Screen 0
      '  Cls
      '     Home : Cline : Home
      '    Print "SEF:";SEF
      '   Print "chcnt:";CHCNT
      '   Print "TT:";TT
      '  Print "TLL";TLL
      '   Print "K:";K
      '   Print "GOOD:";GOOD
      '    Print "EOT:";EOT
      '    Print "laspc:";LASPC
      'Screen 5
      GRABAKEY
      CHECKAKEY
      PLOPIT
      Exit If TED=0
   Loop
   Menu On
   On Menu On
   KLIPPERG
   Curs Off
   MESS[Space$(36)]
   MESS["Click left button to continue"]
   Ink IC
End Proc
Procedure GRABAKEY
   TZ=0 : MK=0 : K=0 : S=0
   Clear Key
   Repeat
      K$=Inkey$
      K=Asc(K$)
      S=Scancode
      TZ=Zone(X Screen(X Mouse),Y Screen(Y Mouse))
      MK=Mouse Click
   Until K$<>"" or MK<>0
End Proc
Procedure CHECKAKEY
   If K>$1F and K<$7F
      GOOD=-1
   Else
      GOOD=0
      If TZ>0 and MK<>0
         If TZ=1
            K=27
         End If
         If TZ=2
            K=8
         End If
         If TZ=3
            S=70
         End If
         If TZ=4
            PASTE
         End If
         If TZ=5
            WIPER
            Screen 5
            LIX=SLIX : LIY=SLIY
            LCNT=1 : UPLINE
         End If
         If TZ=6
            If LCNT<TLN
               Inc LCNT
               UPLINE
               LIY=LIY+24
            End If
         End If
         If TZ=7
            If LCNT>1
               Dec LCNT
               DWNLINE
               LIY=LIY-24
            End If
         End If
         If TZ=8
            K=30
         End If
         If TZ=9
            K=29
         End If
         If TZ=10
            K=28
         End If
         If TZ=11
            K=13
         End If
         If TZ=12
            If Not SCUP
               MOVTXSC
            Else
               MOVTXSCD
            End If
         End If
      End If
      If K=8 and CHCNT>1
         TEXL[" "] : TT=TT+T1
         Cleft : Print " "; : A$(CHCNT)=" " : Cleft : Dec CHCNT
      End If
      If K=29 and CHCNT>1
         Cleft : Dec CHCNT
      End If
      If K=28 and CHCNT<EOT
         Cright : Inc CHCNT
      End If
      If K=30
         INSY
      End If
      If S=70
         DELI
      End If
      If K=27
         EDBUTDOWN
         TED=0
      End If
      If K=13
         CLTEX
      End If
   End If
End Proc
Procedure DELI
   TEXL[A$(CHCNT)]
   TT=TT-T1
   For N=CHCNT To EOT
      A$(N)=A$(N+1)
   Next N
   A$(EOT+1)=" "
   Curs Off
   Locate STAR,6
   For N=1 To EOT
      Print A$(N);
   Next N
   Dec EOT
   Locate STAR+CHCNT-1,6
   Curs On
End Proc
Procedure INSY
   TEXL[" "]
   TT=TT+T1
   Inc EOT
   For N=1 To EOT : T$(N)=A$(N) : Next N
   A$(CHCNT)=" "
   For N=CHCNT To EOT
      X$=T$(N)
      A$(N+1)=X$
   Next N
   Curs Off
   Locate STAR,6
   For N=1 To EOT
      Print A$(N);
   Next N
   Curs On
   Locate STAR+CHCNT-1,6
End Proc
Procedure CURSET
   Flash 7,"(0f0,10)(fff,10)(f00,10)(fff,10)"
   L1=%0
   L2=%0
   L3=%0
   L4=%0
   L5=%0
   L6=%0
   L7=%10000001
   L8=%11111111
   Set Curs L1,L2,L3,L4,L5,L6,L7,L8
   Curs Pen 7
   Curs On
   Bell 50
End Proc
Procedure PLOPIT
   If GOOD and TT<TLL
      Print K$;
      A$(CHCNT)=K$
      If K$=" "
         LASPC=CHCNT
      End If
      If CHCNT=>EOT
         TEXL[K$]
         TT=TT+T1
         If TT>TLL-60
            Bell 70-BEOH
            Add BEOH,1,10 To 65
         End If
         If TT=>TLL
            Boom : Wait 5
            Curs Off
            Locate STAR+LASPC,6
            If LASPC>0
               Cline EOT
               Locate STAR,6
               For N=1 To LASPC
                  Print A$(N);
               Next N
               For N=LASPC To EOT : A$(N)=" " : Next N
               EOT=LASPC
               TT=0
               For N=1 To EOT
                  TEXL[A$(N)]
                  TT=TT+T1
               Next N
            End If
            CHCNT=0
            Locate STAR,6
            Bell 20
         End If
      End If
      K$=""
      Inc CHCNT
      Curs On
   End If
End Proc
Procedure SETUP
   ED
   CURSET
   Screen 5
   Limit Mouse
   Reserve Zone 12
   Set Zone 1,16,24 To 50,39
   Set Zone 2,456,25 To 500,40
   Set Zone 3,528,24 To 572,40
   Set Zone 4,14,88 To 232,99
   Set Zone 5,16,107 To 230,119
   Set Zone 6,180,69 To 202,77
   Set Zone 7,210,69 To 230,77
   Set Zone 8,510,75 To 554,91
   Set Zone 9,468,101 To 512,116
   Set Zone 10,556,101 To 602,117
   Set Zone 11,392,74 To 434,117
   Set Zone 12,192,19 To 320,31
   Pen 0
   Ink 0
   Paper 1
   KLIPPERT
   If TXP=0
      EOT=0
      LASPC=0
      CHCNT=1
      Locate STAR,6
      For N=1 To 80 : A$(N)=" " : Next N
      If EOT>0
         Cline EOT
      End If
      TXP=1
   Else
      Locate STAR,6
      For N=1 To EOT : Print A$(N); : Next N
      Locate CHCNT,6
   End If
   Locate STAR,6
   SCUP=0
   FRD=0
End Proc
Procedure OFFWEGO
   Close Workbench
   Close Editor
   Voice 15
   Volume 20
   Mvolume 63
   Music 1
   Sample 1 To 15
   'Load Iff "tit.iff",0
   'Spack 0 To 10
   'Stop
   Unpack 10 To 1
   Unpack 10 To 0
   Get Palette 0
   Flash Off : Curs Off
   Locate ,20
   Centre "Setting the fonts - please wait"
   Wait 5
   BEL=10
   MUS=1
   CM=1
   SA=1
   STAR=10
   PCNT=0
   TED=0
   TXP=0
   Get Fonts
   '  Cls
   '  For N=1 To 20
   ' Print N;" ";Font$(N)
   'Next N
   'Stop
   Set Font 3
   Set Font 4
   Set Font 5
   Set Font 6
   Set Font 7
   Set Font 8
   Set Font 9
   Set Font 10
   ''Stop
   Get Rom Fonts
   '
   Set Font 2
   Bank To Menu 9
   Set Font 2
   Pen 0
   Locate ,20
   Centre "Click the      mouse button to start."
   Pen 2 : Locate 31, : Print "LEFT"
   Locate ,22
   Pen 0
   Centre "Click the       mouse button to read/print the docs."
   Pen 2 : Locate 24, : Print "RIGHT" : Pen 0
   On Menu Proc MUS,CUL,FL,PGE,TEX,EX,DIS,EXT
   Flash 2,"(f00,23)(0f0,23)(00f,23)(fc1,23)"
   Repeat : MK=Mouse Key : Until MK<>0
   Locate ,20 : Cline : Locate ,22 : Cline
   If MK=2 Then DUCKS
   '    Screen 1 : Cls
   '   Screen 0 : Cls
   SEF=5
   '   If Not Exist("DF0:books")
   '      Mkdir "df0:books"
   '   End If
         Dir$="df0:books"
         Set Dir 8,"*.dat"
   Flash Off
   Colour 2,$F00
   Menu On
   On Menu On
End Proc
Procedure PASTE
   Screen 0
   Ink 0
   Set Font SEF
   Z$=""
   For N=1 To 80
      Z$=Z$+A$(N)
   Next N
   Text LIX,LIY,Z$
   Screen Copy 0 To 1
   If LCNT=TLN
      LCNT=1 : LIY=SLIY
   Else
      LIY=LIY+24
      Inc LCNT
   End If
   Screen 5 : UPLINE : Screen 0
   BUMP:
   Set Font 2
   Screen 5
End Proc
Procedure MOVTXSC
   SCUP=-1
   Wait Vbl
   Screen Display 5,,175,,
   For N=175 To 15 Step -1
      Screen Display 5,,N,,
      If N/2=Int(N/2)
         Wait Vbl
      End If
   Next N
   Wait Vbl
   If Not FRD
      FOURD
      FRD=-1
   End If
   Screen 5
   Limit Mouse
End Proc
Procedure KLIPPERT
   Screen 0
   Clip
   ' for text
   If PSEL=1 Then Clip 5,5 To 635,250 : PTX=5 : PTY=5 : PBX=635 : PBY=250
   If PSEL=2 Then Clip 5,5 To 305,250 : PTX=5 : PTY=5 : PBX=305 : PBY=250
   If PSEL=3 Then Clip 5,150 To 635,250 : PTX=5 : PTY=150 : PBX=635 : PBY=250
   If PSEL=4 Then Clip 5,225 To 635,250 : PTX=5 : PTY=225 : PBX=635 : PBY=250
   Screen 5
End Proc
Procedure KLIPPERG
   Screen 0
   Clip
   'for graphics
   If PSEL=1 Then Clip 1,1 To 2,2 : PTX=1 : PTY=1 : PBX=2 : PBY=2
   If PSEL=2 Then Clip 315,5 To 635,250 : PTX=315 : PTY=5 : PBX=635 : PBY=250
   If PSEL=3 Then Clip 5,5 To 635,135 : PTX=5 : PTY=5 : PBX=635 : PBY=135
   If PSEL=4 Then Clip 5,5 To 635,230 : PTX=5 : PTY=5 : PBX=635 : PBY=230
   Screen 4
End Proc
Procedure DUN
   FOURD
   On Menu Off
   Menu Off
   Repeat : Until Mouse Click
   FOURUP
   Menu On
   On Menu On
End Proc
Procedure FOURUP
   N=300
   If Rnd(5)=1
      MESS[Space$(36)]
      MESS[" Peek-A-Boo! "]
   Else
      MESS[Space$(36)]
      MESS["Hello again!"]
   End If
   Wait Vbl
   Screen Display 4,,N,,
   Curs Off
   For N=300 To 250 Step -1
      Screen Display 4,,N,,
      If N/2=Int(N/2) Then Wait Vbl
   Next N
   SCRPOS=250
   Wait Vbl
   FRD=0
End Proc
Procedure UPLINE
   CL$=Str$(LCNT)
   If LCNT<10 Then CL$=Right$(CL$,1) : CL$="0"+CL$
   If LCNT=10 Then CL$=Right$(CL$,2)
   If LCNT<=TLN
      Ink 3,6
      Text 155,75,CL$
      Bell 5*LCNT+5
   Else
      Bell 20
      LCNT=1 : LIY=SLIY
   End If
   Pen 0 : Paper 1
   Locate STAR+CHCNT-1,6
End Proc
Procedure DWNLINE
   CL$=Str$(LCNT)
   If LCNT<10 Then CL$=Right$(CL$,1) : CL$="0"+CL$
   If LCNT=10 Then CL$=Right$(CL$,2)
   If LCNT<TLN+1
      Ink 3,6
      Text 155,75,CL$
      Bell 5*LCNT+5
   Else
      Bell 20
   End If
   Pen 0 : Paper 1
   Locate STAR+CHCNT-1,6
End Proc
Procedure MOVTXSCD
   SCUP=0
   Wait Vbl
   For N=15 To 175
      Screen Display 5,,N,,
      If N/2=Int(N/2)
         Wait Vbl
      End If
   Next N
   Wait Vbl
   Screen 5
   Limit Mouse
End Proc
Procedure EXEC[C$]
   '
   ' Open a input/output null channel
   A$="NIL:"+Chr$(0)
   Dreg(1)=Varptr(A$) : Dreg(2)=1004
   HAND=Doscall(-30)
   '
   If HAND
      '
      ' Send the command to AmigaDos
      C$=C$+Chr$(0)
      Dreg(1)=Varptr(C$) : Dreg(2)=HAND : Dreg(3)=HAND
      F=Doscall(-222)
      '
      ' Close the channel
      Dreg(1)=HAND
      A=Doscall(-36)
   End If
   '
   ' -1 if ok
End Proc[F]
Procedure SAVY
   F$=Dir$
   If Right$(F$,6)="books/" Then SETTIT
   If Not CHANGED
      Inc PCNT
   End If
   PAGE$="Page"+Str$(PCNT)
   F$=Fsel$("",PAGE$,"Press return to save as new page","Or click on other page to replace this")
   If F$<>""
      Inc TP
      If Not Exist("df0:doc")
         BOMB
      End If
      If TP=>4
         BOMB
      End If
      P=1
      If PCNT>9
         P=2
      End If
      PAGE$=Right$(F$,P)
      PCNT=Val(PAGE$)
      PAGE$="Page "+PAGE$
      Change Mouse 3
      MESS[Space$(36)]
      MESS["Saving this page - please wait."]
      Screen 0
      Save Iff F$
      P1$=Str$(PCNT) : P2$=Str$(PSEL) : P3$=Str$(LCNT) : P4$=Str$(TP)
      Open Out 1,PAGE$+".dat"
      Print #1,P1$
      Print #1,P2$
      Print #1,P3$
      Print #1,P4$
      Close 1
      MESS[Space$(36)]
      MESS["Please select a tool or menu item."]
      Change Mouse CM
   End If
   On Menu On
   CHANGED=0
End Proc
Procedure LOUD
   F1$=Dir$
   If Right$(F1$,6)="books/" Then SETTIT
   If F$<>""
      F$=Fsel$("","","Double Click on the page required","")
      Change Mouse 3
      P=1
      If PCNT>9
         P=2
      End If
      PAGE$=Right$(F$,P)
      PCNT=Val(PAGE$)
      PAGE$="Page "+PAGE$
      MESS[Space$(36)]
      MESS["Setting up new page - please wait."]
      Open In 1,PAGE$+".dat"
      Line Input #1,P1$
      Line Input #1,P2$
      Line Input #1,P3$
      Line Input #1,P4$
      Close 1
      PCNT=Val(P1$) : PSEL=Val(P2$) : LCNT=Val(P3$) : TP=Val(P4$)
      If TP>4
         BOMB
      End If
      Load Iff F$,0
      SETPAGE
      Screen Copy 0 To 1
      Screen 0 : Screen To Back : Screen 1 : Screen To Back
      MESS[Space$(36)]
      MESS["Please select a tool or menu item."]
      Change Mouse CM
   End If
   On Menu On
   CHANGED=-1
End Proc
Procedure DIS
   If Choice(2)=1 Then SAVY
   If Choice(2)=2 Then LOUD
   If Choice(2)=3 Then SETTIT
   If Choice(2)=4 Then DELP
   If Choice(2)=5 Then DELB
End Proc
Procedure SETTIT
   MESS[Space$(36)]
   Locate 24,2
   MESS["Enter your book's title: [           ]"]
   GITIT
   Curs Off
   If F$<>""
      Dir$="df0:books/"
      TP=0
      Inc BC
      If Not Exist("df0:doc")
         BOMB
      End If
      If BC=>3
         BOMB
      End If
      MESS[Space$(38)]
      If Not Exist(F$)
         MESS["Setting up your new book"]
         Mkdir F$
      End If
      MESS[Space$(38)]
      M$=F$+" is ready to use."
      MESS[M$]
      Dir$=F$
      CHANGED=-1
      PCNT=1
   Else
      MESS[Space$(38)]
      MESS["Please select a tool or menu item."]
   End If
   On Menu On
End Proc
Procedure DELP
'   F$=Fsel$("","","Deleting","")
'   If F$<>""
'      Kill F$
'   End If
'   On Menu On
BOMB
End Proc
Procedure DELB
   BOMB
End Proc
Procedure TEXL[X$]
   Set Font SEF
   T1=Text Length(X$)
   Set Font 2
End Proc
Procedure CLTEX
   Locate STAR,6 : If EOT>0 Then Cline EOT
   CHCNT=1
   EOT=0
   BEOH=10
   TT=0
   LASPC=0
   For N=1 To 80 : A$(N)=" " : Next N
End Proc
Procedure GITIT
   Locate 50,2
   F$=""
   N=0
   Curs On
   Bell 50
   Repeat
      A$=Inkey$
      A=Asc(A$)
      If A>31 and A<128
         F$=F$+A$
         Print A$;
         N=N+1
      End If
      If A=8 or N=11
         F$=""
         N=0
         Locate 50,2
         Cline 11
         Bell 50
      End If
   Until A$=Chr$(13)
   Curs Off
End Proc
Procedure DUCKS
'
Amos To Back
EXEC["ppmore doc"]
Amos To Front
'
End Proc
Procedure BOMB
   Menu Off
   On Menu Off
   Hide
   Break Off
   Mvolume 60
   Music 1
   Unpack 14 To 5
   Get Palette 5
   Flash 0,"(fff,23)(f00,23)(0f0,23)(00f,23)(fc1,23)"
   Colour 6,0
   Screen Display 5,,100,,
   Do :
Loop
End Proc